home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swags_z.zip / SOUND.SWG / 0005_PIANO.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  4KB  |  137 lines
  1. {
  2. BILL BUCHANAN
  3.  
  4. > I'm just learning Pascal, and I was 1dering if it's possible 2 play
  5. > music in Pascal?  if so... how?
  6.  
  7. Here's a little Program that allows you to play the "PIANO" on your keyboard.
  8. No Soundcard needed or anything like that.  This may give you a small idea
  9. on how to create your own Sounds ...
  10.  
  11. }
  12.  
  13. Program Music;                         {by Judy Birmingham, 9/18/92}
  14. Uses
  15.   Crt;
  16.  
  17. Const
  18.   {-------------------------------------------------------------------}
  19.   {These values will Vary by the song you choose}
  20.   {I wish I could have made these Variables instead of Constants,
  21.   but I seemed to be locked into using Const, because they define
  22.   Array sizes in the Types declared below.}
  23.  
  24.   TotalLinesInSong = 4;             {Number of lines in song}
  25.   MaxNotesInPhrase = 9;             {Max number of notes in any line}
  26.   BeatNote         = 4;             {Bottom number in Time Signature}
  27.                                     {Handles cut time (2/2), 6/8 etc.}
  28.   Tempo            = 160;           {Number of beats per minute}
  29.   {-------------------------------------------------------------------}
  30.   {Note frequencies}
  31.   R = 0;                            {Rest = frequency of 0 : silence}
  32.   C = 260;                          {Frequency of middle c          }
  33.   CC = 277;                         {Double letter indicates a sharp}
  34.   D = 294;
  35.   DD = 311;
  36.   E = 330;
  37.   F = 349;
  38.   FF = 370;
  39.   G = 392;
  40.   GG = 415;
  41.   A = 440;
  42.   AA = 466;
  43.   B = 494;
  44.  
  45.   {Note durations}
  46.   Q  = 1 * (BeatNote/4);                            {Quarter note}
  47.   I  = 0.5 * (BeatNote/4);                          {Eighth note}
  48.   H  = 2 * (BeatNote/4);                            {Half note}
  49.   W  = 4 * (BeatNote/4);                            {Whole note}
  50.   S  = 0.25 * (BeatNote/4);                         {Sixteenth note}
  51.   DQ = 1.5 * (BeatNote/4);                          {Dotted quarter}
  52.   DI = 0.75 * (BeatNote/4);                         {Dotted eighth}
  53.   DH = 3 * (BeatNote/4);                            {Dotted half}
  54.   DS = 0.375 * (BeatNote/4);                        {Dotted sixteenth}
  55.  
  56.   Beat = 60000/Tempo;       {Duration of 1 beat in millisecs}
  57.  
  58. Type
  59.   IValues = Array [1..MaxNotesInPhrase] of Integer;
  60.   RValues = Array [1..MaxNotesInPhrase] of Real;
  61.   Phrase  = Record
  62.     Lyric  :  String;
  63.     Notes  : IValues;   {Array of note frequencies}
  64.     Octave : IValues;   {Array of note octaves}
  65.     Rhythm : RValues;   {Array of note durations}
  66.   end;
  67.   Song = Array [1..TotalLinesInSong] of Phrase;
  68.  
  69.  {Sample song}
  70. Const
  71.   RowRow : Song = (
  72.     (Lyric : 'Row Row Row Your Boat';
  73.     NOTES   :  (C,C,C,D,E,R,0,0,0);
  74.     OCTAVE  :  (1,1,1,1,1,1,0,0,0);
  75.     RHYTHM  :  (DQ,DQ,Q,I,Q,I,R,0,0)
  76.     ),
  77.  
  78.     (Lyric : 'Gently down the stream';
  79.     NOTES   :  (E,D,E,F,G,R,0,0,0);
  80.     OCTAVE  :  (1,1,1,1,1,1,0,0,0);
  81.     RHYTHM  :  (Q,I,Q,I,DQ,DQ,0,0,0)
  82.     ),
  83.  
  84.     (Lyric : 'Merrily merrily merrily merrily';
  85.     NOTES :  (C,C,G,G,E,E,C,C,0  );
  86.     OCTAVE : (2,2,1,1,1,1,1,1,0  );
  87.     RHYTHM : (Q,I,Q,I,Q,I,Q,I,0  )
  88.     ),
  89.  
  90.     (Lyric : 'Life is but a dream.';
  91.     NOTES  : (G,F,E,D,C,R,0,0,0  );
  92.     OCTAVE : (1,1,1,1,1,1,0,0,0  );
  93.     RHYTHM  : (Q,I,Q,I,H,Q,0,0,0  )
  94.     ));
  95.  
  96. Procedure LYRICS(THE_WORDS : String);
  97. begin
  98.   Writeln(THE_WORDS);
  99. end;
  100.  
  101. Procedure PLAYNOTE (NOTE, OCT: Integer; DURATION : Real);
  102. begin
  103.   Sound (NOTE * OCT);
  104.   Delay (Round(BEAT * DURATION));
  105.   NoSound;
  106. end;
  107.  
  108. Procedure PLAYPHRASE(N : Integer; NOTES, OCTAVE : IValues; RHYTHM : RValues);
  109. Var
  110.   INDEX : Integer;
  111. begin
  112.   For INDEX := 1 to N do
  113.     PLAYNOTE (NOTES[INDEX], OCTAVE[INDEX], RHYTHM[INDEX]);
  114. end;
  115.  
  116. Procedure PLAYSONG (Title : String; Tune : Song);
  117. Var
  118.   Counter : Integer;
  119. begin
  120.   ClrScr;
  121.   GotoXY(11,3);
  122.   Writeln (Title);
  123.   Window (10,5,70,19);
  124.   ClrScr;
  125.   For counter := 1 to TotalLinesInSong do
  126.   begin
  127.     LYRICS(Tune[counter].Lyric);
  128.     PLAYPHRASE(MaxNotesInPhrase, Tune[counter].Notes,
  129.                Tune[counter].Octave, Tune[counter].Rhythm);
  130.   end;
  131. end;
  132.  
  133. begin
  134.   ClrScr;
  135.   PlaySong('"Row Row Row Your Boat "', RowRow);
  136. end.
  137.